;CWL:<403-INET>INFREE.MAC.40301 29-Jan-82 15:11:42, Edit by CLYNN
; Updated for IP release 3
;[BBNF]<401-INET>INFREE.MAC.16, 14-Jul-81 11:54:00, Ed: CLYNN
; Bug: Returning core beyond end of section & loop in ODDBLK chain
;     (End-of-list matching end-of-memory (INTSEC,,0) in SPUT4)
;[BBND]<401-INET>INFREE.MAC.15, 10-Feb-81 10:19:37, Ed: CLYNN
;ODDBLK is not in INTSEC
;	GCARVE+2	MOVEI PRV,ODDBLK	XMOVEI PRV,ODDBLK
;	       3	SETSEC PRV,INTSEC
;BLK is used as a temp which destroies the routine return value; use T3
;	GCARV1+4	LOAD BLK,FLIST,(BLK)	LOAD T3,FLIST,(BLK)
;	       5	STOR BLK,FLIST,(PRV)	STOR T3,FLIST,(PRV)
;T1 is not initialized to BLK
;	CSPLIT		LOAD T3,FSIZE,(BLK)	LOAD T3,FSIZE,(BLK)
;						MOVE T1,BLK
;T2 is not initialized to SIZ, replace T2 by SIZ
;	CSPLIT+3	STOR T2,FSIZE,(BLK)	STOR SIZ,FSIZE,(BLK)
;	       4	SUBI T3,UBLKSZ(T2)	SUBI T3,UBLKSZ(SIZ)
;[BBND]SNARK:<401-INET>INFREE.MAC.14, 23-Jan-81 12:35:30, Ed: TAPPAN

	SEARCH	INPAR,PROLOG
	TTITLE	INFREE
	SUBTTL	Internet Free Storage Routines, Wm W. Plummer 9FEB77
	SWAPCD

COMMENT	!
	Routines to manage the INT freestorage area.  Designed to
	provide quick access to commonly used block sizes.

* FREINI ...  4 ...... Initialize the freestorage package
* FREAVL ...  4 ...... Returns the amount of available free storage

* RETBLK ...  5 ...... Return a block to free storage
  RETBK0 ...  5 ...... Internal routine to return a block
  RETB .....  6 ...... Subr. Called by INTFRE and the user
  SPUT .....  7 ...... Chain a block onto a list

* GETBBK ...  9 ...... Get biggest block of free storage
  GETBB0 ... 10 ...... Workhourse for GETBBK
* GETBLK ... 11 ...... Get a specific size block of free storage
  GETBK0 ... 12 ...... Workhorse for GETBLK
  GETB ..... 13 ...... Subr. called by INTFRE and the user
  GCARVE ... 14 ...... Carve an oddblock into required size
  CSPLIT ... 15 ...... Subr. actually split a block
  BULKCV ... 16 ...... Carve a block out of bulk area
  GC ....... 18 ...... Garbage collect the odd blocks list
  LCOPY .... 19 ...... Copy one list onto another
  RETLST ... 20 ...... Return a list of blocks to free storage

  CHKBLK ... 20 ...... Check validity of block returned by user

  HASH ..... 21 ...... Local hash function
  HASHX .... 22 ...... Returns hash indext to INTBLK table

******* N.B.  The ACs named BLK, SIZ, and LST are used globally
	      within this file.
	!

; AC redefinitions:

IF1 <
BLK=1+NTEMPS+NLOCLS-3		; Holds pointer to block in question
SIZ=1+NTEMPS+NLOCLS-2		; Holds size of block
LST=1+NTEMPS+NLOCLS-1		; Holds pointer to a list of blocks
NLOCLS==NLOCLS-3
>

; Note: INTBLK contains FSIZE,,FLIST;  i.e. a header w/o FNEXT
; Definitions for FREE block header structure:

DEFSTR(FSIZE,0,17,18)		; (User) Block size (excluding UBLKSZ)
DEFSTR(FLIST,0,35,18)		; List of other blocks
DEFSTR(FNEXT,1,35,18)		; Next block higher in memory
FBLKSZ==2			; Size of a FREE block header


; Definitions for USED block header structure:

DEFSTR(USIZE,0,17,35)		; (User) Block size (excluding UBLKSZ header)
DEFSTR(UHASH,0,35,18)		; Hash. Guards against user clobbering
UBLKSZ==1			; Size of a USED block header



; Block size quantitization -- all blocks except very short ones
; are forced to be a multiple of this size.

BSMALL==10			; Don't quantize this size or smaller
BSQUAN==10			; Must be a power of 2

; FREINI	Initialize the Free Storage area

;	CALL FREINI
;Ret+1:	Always.

FREINI::SETZM ODDBLK		; No odd size blocks returned yet

	MOVE T1,[INTBLK,,INTBLK+1]	; Set for a BLT
	SETZM INTBLK		; Clear 1st word of table
	BLT T1,INTBLK+NFIXED-1	; Clear rest

IFNKA <	MOVE T2,[INTSEC,,INTFRE]>; Pointer to the INT free area
IFKA <	MOVEI T2,INTFRE>
	SKIPN EXADFL		; Machine has extended addressing?
	 HRRZS T2		; No.  INTFRE is in section 0
	MOVEM T2,BULKST		; Beginning of bulk storage
	ADDI T2,INTFSZ-1
	MOVEM T2,BULKND		; End of the bulk storage
	MOVEI T4,INTFSZ
	MOVEM T4,INTFSP		; Amount of free space available

	SETZM MRGFLG		; No block merging possible yet.

	SETZM INTSVC		; Count of scavenges done
	SETZM INTSVT		; TODCLK filter of excessive BUGINF's
	SETZM INTSVR		; Scavenge request flag

	MOVEI T1,FRELCK		; Free storage lock
	CALLRET CLRLCK		; Initialize it



; FREAVL	Returns amount of free storage available

;	CALL FREAVL
;Ret+1:	Always, number of words in T1

FREAVL::MOVE T1,INTFSP
	RET

; RETBLK	Return a block to free area

;T1/	(Extended) Pointer to the user portion of the block
;
;	CALL RETBLK
;Ret+1:	Always

RETBLK::XMOVEI T3,-UBLKSZ(T1)	; Pointer to free header
	XMOVEI T2,[PUSH P,BLK	; Save ACs which will be
		PUSH P,SIZ	; as globals
		PUSH P,LST
		MOVE BLK,T1	; Set block pointer
		LOAD SIZ,USIZE,(BLK)	; and size (excluding header)
		CALL RETBK0	; Do the returning
		POP P,LST
		POP P,SIZ
		POP P,BLK
		RET]
	MOVEI T1,FRELCK		; Lock to set
	CALLRET LCKCAL		; Lock and call.



; RETBK0	Workhorse for above.  Called with NOINT & FRELCK set.

;BLK/	(Extended) Pointer to the block to return
;SIZ/	Size of the block, excluding header
;
;	CALL RETBK0
;Ret+1:	Always

RETBK0:	CALL CHKBLK		; Make sure header not crashed by user
	MOVEI T1,UBLKSZ(SIZ)	; Total length of the block
	ADDM T1,INTFSP		; Amount of free storage now available
	ADD T1,BLK		; Next location in memory
	STOR T1,FNEXT,(BLK)	; Save in free block
	SETZRO FLIST,(BLK)	; Block may become the end of a list
	SETOB T1,MRGFLG		; Say common size and merging possible
	CALLRET RETB

; RETB	Return the block to some list. Called with NOINT & FRELCK set.

;BLK/	(Extended) Block	; with FSIZE & FNEXT
;SIZ/	Size of the block	; Excluding header
;T1/	UserCall Flag		; Non-zero says to create a slot in
;				  INTBLK for this size
;
;	CALL RETB
;Ret+1:	Always

RETB:	PUSH P,T1		; Save the flag
	CALL HASHX		; Get -1 or index to INTBLK
	POP P,T2		; Restore the flag
	JUMPL T1,RETB1		; Jump if there is no slot for this size
	JUMPE T2,RETB1		; Jump if not a user's block size
	MOVEI T2,INTBLK(T1)	; Pointer to the list head
	LOAD LST,FLIST,(T2)	; Pointer to the list itself
	STOR LST,FLIST,(BLK)	; Make block point to current tail
	STOR BLK,FLIST,(T2)	; Make head point to new front of list
	STOR SIZ,FSIZE,(T2)	; Be sure size is right in the table
	EXIT RETBX

RETB1:	PUSH P,LST		; RETLST wants this preserved
	MOVE LST,ODDBLK		; The appropriate (extended) list
	CALL SPUT		; Put block on that list
	MOVEM LST,ODDBLK	; New list with block on it
	POP P,LST

RETBX:	RET

; SPUT(Block, List)	Put a block on an address ordered list

;BLK/	(Extended) Block pointer  with FSIZE & FNEXT
;LST/	(Extended) List pointer
;
;	CALL SPUT
;Ret+1:	Always.  New list containing Block in LST

SPUT:	TEMP <CUR,SUC>
	TRNE LST,-1
	 JRST SPUT1		; Jump if not adding to null list
	STOR LST,FLIST,(BLK)	; Clear list pointer in block
	MOVE LST,BLK		; New list has only this block
	EXIT SPUTX		; Return LST as new list

SPUT1:	CAML BLK,LST		; Adding to front of list?
	 JRST SPUT2		; No. Search for right spot.
;	could check that FNEXT(BLK) <= LST
	STOR LST,FLIST,(BLK)	; Make BLK be first on the list
	MOVE SUC,LST		; Init so rest works
	MOVE LST,BLK		; Value to be returned
	MOVE CUR,BLK		; Current block on list
	JRST SPUT4

SPUT2:	SKIPA CUR,LST		; Start at beginning of list
SPUT3:	MOVE CUR,SUC		; Advance to next on list
	LOAD SUC,FLIST,(CUR)	; Get the successor to CUR
	SETSEC SUC,INTSEC	; Make extended address
	CAML BLK,SUC		; BLK must be below SUC
	TRNN SUC,-1		; or SUC must be (INTSEC,,) 0
				; (CUR is end of list)
	CAMG BLK,CUR		; and BLK must be above CUR
	 JRST SPUT3		; Not right place for insert

;	could check that FNEXT(CUR) <= BLK & FNEXT(BLK) <= SUC
	STOR SUC,FLIST,(BLK)	; Patch in BLK between CUR and SUC
	STOR BLK,FLIST,(CUR)

SPUT4:	LOAD T4,FNEXT,(BLK)	; Word address following BLK
	JUMPE T4,SPUT5		; Beware match on INTSEC,,0
	SETSEC T4,INTSEC	; Make extended address
	CAME T4,SUC		; Combine BLK and SUC ?
	 JRST SPUT5		; No
	LOAD T3,FSIZE,(BLK)	; SUC is real block, not INTSEC,,0
	LOAD T4,FSIZE,(SUC)	; end pointer
	ADDI T3,UBLKSZ(T4)	; Size of combined block
	STOR T3,FSIZE,(BLK)
	LOAD T4,FNEXT,(SUC)	; End of SUC
	STOR T4,FNEXT,(BLK)	; Is new end of combined block
	LOAD SUC,FLIST,(SUC)	; Successor of SUC is new SUC
	STOR SUC,FLIST,(BLK)	; and successor of combined BLK

SPUT5:	LOAD T3,FNEXT,(CUR)	; Address following CUR
	SETSEC T3,INTSEC	; Make extended address
	CAME T3,BLK		; Combine CUR and BLK?
	 EXIT SPUTX
	LOAD T3,FSIZE,(CUR)
	LOAD T4,FSIZE,(BLK)
	ADDI T3,UBLKSZ(T4)
	STOR T3,FSIZE,(CUR)	; Set size of combined block
	LOAD T4,FLIST,(BLK)	; Successor of BLK
	STOR T4,FLIST,(CUR)	; Is successor of combined block
	LOAD T4,FNEXT,(BLK)	; Get thing following BLK in memory
	STOR T4,FNEXT,(CUR)	; That is what follows compbined block
SPUTX:	RESTORE
	RET

;GETBBK		Assign biggest block of free storage

; 0 may be returned as a value meaning no space was available.
;  The caller is expected to cope with this situation.

;T1/	Minimum acceptable size
;T2/	Maximum usefull size
;
;	CALL GETBBK
;Ret+1:	Always.  T1 has 0 or or size,,pointer
;***** N.B.:  T1 does not have an extended address *****

GETBBK::DMOVEM T1,T3		; Place args for call via LCKCAL
	MOVEI T1,FRELCK		; The lock to set
	XMOVEI T2,[PUSH P,BLK	; Save ACs which will be
		PUSH P,SIZ	; Used as globals
		PUSH P,LST
		MOVE SIZ,T2	; Max size
		CALL GETBB0	; Do the work
		MOVE T1,BLK	; Value for caller
		POP P,LST
		POP P,SIZ
		POP P,BLK
		RET]
	CALLRET LCKCAL		; Call the function with the lock set

;GETBB0		Workhorse for the above. Called with NOINT & FRELCK set.
;
;T1/	Min. size
;SIZ/	Max. size, excluding header
;FRELCK set
;
;	CALL GETBB0
;Ret+1:	Always.  BLK has 0 or size,,pointer

GETBB0:	LOCAL <MINSIZ>
	MOVEM T1,MINSIZ
	CALL GETBK0		; Use normal GETBLK routine
	JUMPN T1,GETBBX		; Exit if we got the max. size block

	; Note that the fail return from GETBK0 indicates that a
	; garbage collect has happened and that all free blocks are
	; now either on the ODDBLK list or INTBLK+n.  Further, no
	; block on ODDBLK is greater than or equal to the MAXSIZ.

	MOVEI SIZ,0		; Init max size seen
	LOAD T2,FLIST,<+ODDBLK>	; Init pointer to first block
GETBB1:	JUMPE T2,GETBB2		; Jump if at end of list
	SETSEC T2,INTSEC	; Make extended address
	LOAD T3,FSIZE,(T2)	; Get size of current block
	CAMLE T3,SIZ		; Bigger than seen before?
	 MOVE SIZ,T3		; Yes.  Save max.
	LOAD T2,FLIST,(T2)	; Point to next block
	JRST GETBB1

GETBB2:	CAMGE SIZ,MINSIZ	; Is the biggest block acceptable?
	 JRST GETBB9		; No.  Tell caller.
	CALL GETBK0
	JUMPN BLK,GETBBX	; Return if all went well.
	INBUG(CHK,<GETBK2: ODDBLK list fouled>,INTFR7)
GETBB9:	SETZB BLK,SIZ		; Failure indication
GETBBX:	HRL BLK,SIZ		; Place size for caller
	RESTORE
	RET

; GETBLK	Assign a block of free storage

; 0 may be returned as a value meaning no space was available.
;  The caller is expected to cope with this situation.

;T1/	Size
;
;	CALL GETBLK
;Ret+1:	Always. 0 or Extended Pointer to block in T1

GETBLK::MOVE T3,T1		; Place in right ac
	MOVEI T1,FRELCK		; Lock to set
	XMOVEI T2,[PUSH P,BLK	; Save ACs which will be
		PUSH P,SIZ	; used globally
		PUSH P,LST
		MOVE SIZ,T1
		CALL GETBK0	; Do the work
		MOVE T1,BLK
		POP P,LST
		POP P,SIZ
		POP P,BLK
		RET]
	CALLRET LCKCAL		; Call routine with lock set

;GETBK0		Workhorse for above. Called with NOINT & FRELCK set.
;
;SIZ/	Size of block to be assigned, excluding header
;
;	CALL GETBK0
;Ret+1:	Always.  0 or Extended Pointer to block in BLK. Must save SIZ.


GETBK0:	JUMPG SIZ,GETBK1
	INBUG (HLT,<GETBK0: Bad block size request>,INTFR4)
	MOVEI SIZ,1		; Min size we ever hand out
GETBK1:	CAILE SIZ,INTFSZ-UBLKSZ	; Max size
	 INBUG (HLT,<GETBK1: Bad block size request>,INTFR5)
	CAIG SIZ,BSMALL		; Don't quantize Q heads etc.
	 JRST GETBK2
	ADDI SIZ,BSQUAN-1	; Round up
	ANDCMI SIZ,BSQUAN-1	; To nearest bigger multiple
GETBK2:	CALL GETB		; Get it from somewhere
	JUMPE BLK,GETBKX	; Couldn't get the block
	MOVNI T2,UBLKSZ(SIZ)	; Size of block we will hand out
	ADDM T2,INTFSP		; Decrease amt of free space available
	CALL HASH		; Get a random number
	STOR T1,UHASH,(BLK)	; Check this when block returned
	STOR SIZ,USIZE,(BLK)	; Set the block size
	XMOVEI BLK,UBLKSZ(BLK)	; Value is user area of the block
GETBKX:	RET

; GETB		Get a block from somewhere. Called with NOINT & FRELCK set.

;SIZ/	Size, excluding header
;
;	CALL GETB
;Ret+1:	Always.   0 or (Extended) Pointer to block in BLK

GETB:	SETZ T1,		; Don't create a slot
	CALL HASHX		; Get index to INTBLK table
	JUMPL T1,GETB2		; Not in table.
	MOVEI T3,INTBLK(T1)	; Address of list head
	LOAD T4,FLIST,(T3)	; Pointer to list of blocks of this size
	JUMPE T4,GETB2		; None.  Try something else.
	SETSEC T4,INTSEC	; Make extended address
	LOAD T2,FLIST,(T4)	; Successor of 1st block on list
	STOR T2,FLIST,(T3)	; Is now first thing on list
	SKIPA BLK,T4		; This block is the result
GETB2:	  CALL GCARVE		; Look elsewhere for a block
	RET

; GCARVE	Carver a block of the required size from an odd block.
;		Called with NOINT & FRELCK set.

;SIZ/	Size, excluding header
;
;	CALL GCARVE
;Ret+1:	Always.   0 or (Extended) Pointer to block in BLK.

GCARVE:	TEMP <PRV>
	SKIPN ODDBLK		; Are there any odd blocks?
	 JRST GCARV4		; No.  Try something else
	XMOVEI PRV,ODDBLK	; Address of pointer to odd block list
	LOAD BLK,FLIST,(PRV)	; Pointer to first odd block

GCARV1:	SETSEC BLK,INTSEC	; Make extended address
	LOAD T2,FSIZE,(BLK)	; Get size of this odd block
	CAME T2,SIZ		; Same as required?
	 JRST GCARV2		; No.  Keep looking.
	LOAD T3,FLIST,(BLK)	; Pointer to block after this one
	STOR T3,FLIST,(PRV)	; Is new successor to one before this
	EXIT GCARVX

GCARV2:	CAIG T2,FBLKSZ+UBLKSZ(SIZ)	; Min we can carve succesffully
	 JRST GCARV3		; Not big enough.
	LOAD T3,FLIST,(BLK)	; Successor of this one
	STOR T3,FLIST,(PRV)	; Snip it out
	CALL CSPLIT		; Split into required plus extra
	EXIT GCARVX

GCARV3:	MOVE PRV,BLK
	LOAD BLK,FLIST,(PRV)	; Move to next odd block
	JUMPG BLK,GCARV1	; And look at it
GCARV4:	CALL BULKCV		; Above failed.  Try bulk storage
GCARVX:	RESTORE
	RET

; CSPLIT		Split an odd block into required size plus extra.
;			Called with NOINT & FRELCK set.
;BLK/	(Extended) BLK
;SIZ/	Required size, excluding header
;
;	CALL CSPLIT
;Ret+1:	Always.  Extended pointer to block of requird size in BLK

CSPLIT:	LOAD T3,FSIZE,(BLK)	; Get size of block to be split
	MOVE T1,BLK		; Get whole block
	ADDI T1,UBLKSZ(SIZ)	; Start of fragment
	SETSEC T1,INTSEC	; Make extended address
	STOR SIZ,FSIZE,(BLK)	; Store size of block to be returned
	SUBI T3,UBLKSZ(SIZ)	; Size of fragment
	STOR T3,FSIZE,(T1)	; Store size of fragment
	LOAD T4,FNEXT,(BLK)	; Block following this in memory
	STOR T4,FNEXT,(T1)
	PUSH P,BLK
	PUSH P,SIZ
	MOVE BLK,T1
	SETZ T1,		; Don't enter this in INTBLK table
	CALL RETB		; Return the fragment to free area
	POP P,SIZ
	POP P,BLK
	RET

; BULKCV		Carve block out of bulk storage.
;			Called with NOINT & FRELCK set.
;SIZ/	Size required, excluding header
;
;	CALL BULKCV
;Ret+1:	Always.  BLK has 0 or extended pointer to block

BULKCV:	MOVE T2,BULKND		; Current end of free storage
	SUB T2,BULKST		; Compute current length
	CAIE T2,UBLKSZ(SIZ)	; Exactly what we need?	(-1)
	 JRST BULKC1		; No.
	MOVEI BLK,0		;			Lose last word
	EXCH BLK,BULKST		; Get beginning of block to return
	SETZM BULKND		; and cancel bulk area
	EXIT BULKCX

BULKC1:	MOVE BLK,BULKST		; Start of what's left
	MOVEI T3,UBLKSZ(SIZ)	; What is needed
	CAIG T2,FBLKSZ+1(T3)	; Big enough to carve?	(-1)
	 JRST BULKC2		; No.
	ADDM T3,BULKST		; Remove from bulk area
	EXIT BULKCX

BULKC2:	JUMPE T2,BULKC3		; Jump if nothing at all left
	STOR T2,FSIZE,(BLK)	; Convert what is left into a block
	MOVE T3,BULKND		; Current End (extended)
	ADDI T3,1		; Next location there after
	STOR T3,FNEXT,(BLK)	; Fix up the block to be returned
	SETZ T1,		; Don't create a INTBLK Slot for it
	CALL RETB		; Return the piece
	SETZM BULKST		; Cancel bulk storage
	SETZM BULKND

BULKC3:	SKIPN MRGFLG		; Merging return blocks possible?
	 JRST BULKC4		; No.  Try something else.
	CALL GC			; Yes. Garbage collect. (Save SIZ)
	CALL GETB		; Assign the block
	EXIT BULKCX

BULKC4:;;Code to get more space from user.... (cannot do this - INTSEC)
	;;MOVEI T1,20		; This many pages
	;;CALL GETFSP		; Get the free space from him
	;;MOVEM T1,BULKST	; New bulk start
	;;ADDI T1,17777		; Compute end
	;;MOVEM T1,BULKND	; Set it
	;;MOVEI T1,17777
	;;ADDM T1,INTFSP	; Bump the amount available
	;;CALL BULKCV		; Carve out a chunk
	;;;;;;;
	MOVE T1,TODCLK		; NOW
	CAMG T1,INTSVT		; OK  to give another typeout?
	 JRST BULKC5		; No.  Not yet.
	 INBUG (INF,<BULKCV: Free storage exhausted>,INTFR6)
	ADDI T1,↑D60000		; 1 minute interval
	MOVEM T1,INTSVT		; Next deadline
BULKC5:	SETOM INTSVR		; And request everybody to do it
	MOVEI T1,0		; None available.  Let caller handle it.
BULKCX:	RET

; GC		Garbage Collector
;		Called with NOINT & FRELCK set.
; Saves SIZ & LST

GC:	LOCAL <I>
	PUSH P,LST
	MOVEI LST,0
	EXCH LST,ODDBLK		; Get and clear odd block list
	MOVSI I,-NFIXED		; AOBJN pointer to INTBLK table

GC1:	MOVEI T1,INTBLK(I)	; Pointer to current list header
	LOAD T1,FLIST,(T1)	; Pointer to first block on list
	JUMPE T1,GC2		; Avoid overhead of LCOPY on null list
	SETSEC T1,INTSEC	; Make extended address
	CALL LCOPY		; Append T1 list to LST
GC2:	SETZM INTBLK(I)		; Nullify the list
	AOBJN I,GC1

	CALL RETLST		; Return (merge) all blocks there on
	SETZM MRGFLG		; No merge possible now.
	POP P,LST
	RESTORE
	RET

;LCOPY		Put blocks from one list on another.
;		Called with NOINT & FRELCK set.
; Saves SIZ; Kills BLK

;T1/	(Extended) Input list
;LST/	(Extended) Output list
;
;	CALL LCOPY
;Ret+1:	Always, LST has the resulting extended list.

LCOPY:	LOCAL <ILST>
	PUSH P,SIZ
	MOVEM T1,ILST

LCOPY1:	TRNN ILST,-1		; End of ILST reached?
	 JRST LCOPYX		; Yes.
	MOVE BLK,ILST		; First block on list
;	LOAD SIZ,FSIZE,(BLK)	; Its size (uses FSIZE)
	LOAD ILST,FLIST,(BLK)	; Get successor for next time
	SETSEC ILST,INTSEC	; Make extended address
	CALL SPUT
	JRST LCOPY1

LCOPYX:	POP P,SIZ
	RESTORE
	RET

; RETLST		Return a list of blocks to free area
;			Called with NOINT & FRELCK set.
;LST/	(Extended) List pointer
;
;	CALL RETLST
;
;Ret+1:	Always.  Clobbers LST; Saves BLK


RETLST:	PUSH P,BLK

RETLS1:	TRNN LST,-1		; End of list?
	 JRST RETLSX		; Yes.  Done.
	MOVE BLK,LST
	LOAD LST,FLIST,(BLK)	; Successor is what to do next time
	SETSEC LST,INTSEC	; Make extended address
	SETZ T1,		; Indicate not being returned by user
	CALL RETB		; Return first block on the list
	JRST RETLS1

RETLSX:	POP P,BLK
	RET



; CHKBLK(Block)		; See that the hash mark is still ok, etc.
;			; Guards against double RETBLKs etc
;BLK/	(Extended) Pointer to block
;SIZ/	Size of the block, excluding UBLKSZ header
;
;	CALL CHKBLK
;Ret+1:	Always.

; Note: Ought to remove first CAIL & -UBLKSZ from second

CHKBLK:	CAIL SIZ,UBLKSZ		; Min size block ever handed out
	CAIL SIZ,INTFSZ-UBLKSZ	; Max size block ever handed out
	 INBUG (HLT,<CHKBLK: Block size clobbered>,INTFR0)
	CALL HASH
	LOAD T2,UHASH,(BLK)	; Get the mark we left there
	CAME T1,T2		; Is it still there?
	 INBUG (HLT,<CHKBLK: Block hash clobbered>,INTFR1)
	RET

;HASHX		Given a block size, HASHX returns the index to INTBLK

;SIZ/	Size
;T1/	CreateFlag	; Non-0 to create slot if not there already
;
;	CALL HASHX
;Ret+1:	Always.  -1 or Index in T1. Saves SIZ.

HASHX:	LOCAL <FLAG>
	TEMP <I,L,Q,T>		; L must be I+1
	MOVEM T1,FLAG
	MOVSI T,-NFIXED		; Set to scan the table

HASHX1:	MOVE I,SIZ
	ADDI I,0(T)		; Add probe count
	IDIVI I,NFIXED		; Rem is the hash function
	MOVE I,I+1		; (to I and L)
	MOVEI L,INTBLK(I)	; Pointer to head of list
	LOAD Q,FSIZE,(L)	; Get size of blocks on this one
	JUMPN Q,HASHX2		; Jump if slot is in use
	JUMPE FLAG,HASHXM	; Return -1 if not supposed to create it
	STOR SIZ,FSIZE,(L)	; Create the list
	EXIT HASHXX

HASHX2:	CAMN Q,SIZ		; Size we are looking for?
	 EXIT HASHXX		; Yes.
	AOBJN T,HASHX1		; Probe again
HASHXM:	SETO T1,		; Fail
HASHXX:	RESTORE
	RET

; HASH		; Return a random number based on location and size

; This number is stored in the block header while the block is in the
; hands of the user.  When he returns the block, a check is made to see
; that it has not been clobbered.

;BLK/	(Extended) Block location
;SIZ/	Block size
;
;	CALL HASH
;Ret+1:	Always.  Hash value in T1

HASH:	MOVEI T1,25252(BLK)	; Flush section number and garble a bit
	IMULI T1,1234(SIZ)	; Mulitply by garbled length
	TSC T1,T1
	HRRZS T1
	RET

	TNXEND
	END